home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / DELAM.ICN < prev    next >
Text File  |  1992-09-28  |  5KB  |  179 lines

  1. ############################################################################
  2. #
  3. #    File:     delam.icn
  4. #
  5. #    Subject:  Program to delaminate file
  6. #
  7. #    Author:   Thomas R. Hicks
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #  
  13. #     This program delaminates standard input into several output
  14. #  files according to the specified fields.  It writes the fields in
  15. #  each line to the corresponding output files as individual lines.
  16. #  If no data occurs in the specified position for a given input
  17. #  line an empty output line is written. This insures that all out-
  18. #  put files contain the same number of lines as the input file.
  19. #  
  20. #     If - is used for the input file, the standard input is read.
  21. #  If - is used as an output file name, the corresponding field is
  22. #  written to the standard output.
  23. #  
  24. #     The fields are defined by a list of field specifications,
  25. #  separated by commas or colons, of the following form:
  26. #  
  27. #          n    the character in column n
  28. #          n-m  the characters in columns n through m
  29. #          n+m  m characters beginning at column n
  30. #  
  31. #  where the columns in a line are numbered from 1 to the length of
  32. #  the line.
  33. #  
  34. #     The use of delam is illustrated by the following examples.
  35. #  The command
  36. #  
  37. #          delam 1-10,5 x.txt y.txt
  38. #  
  39. #  reads standard input and writes characters 1 through 10 to file
  40. #  x.txt and character 5 to file y.txt.  The command
  41. #  
  42. #          delam 10+5:1-10:1-10:80 mid x1 x2 end
  43. #  
  44. #  writes characters 10 through 14 to mid, 1 through 10 to x1 and
  45. #  x2, and character 80 to end.  The command
  46. #  
  47. #          delam 1-80,1-80 - -
  48. #  
  49. #  copies standard input to standard output, replicating the first
  50. #  eighty columns of each line twice.
  51. #  
  52. ############################################################################
  53. #
  54. #  Links: usage
  55. #
  56. ############################################################################
  57.  
  58. link usage
  59.  
  60. procedure main(a)
  61.    local fylist, ranges
  62.    if any(&digits,a[1]) then
  63.       ranges := fldecode(a[1])
  64.    else
  65.       {
  66.       write(&errout,"Bad argument to delam: ",a[1])
  67.       Usage("delam fieldlist {outputfile | -} ...")
  68.       }
  69.    if not a[2] then
  70.       Usage("delam fieldlist {outputfile | -} ...")
  71.    fylist := doutfyls(a,2)
  72.    if *fylist ~= *ranges then
  73.       stop("Unequal number of field args and output files")
  74.    delamr(ranges,fylist)
  75. end
  76.  
  77. # delamr - do actual division of input file
  78. #
  79. procedure delamr(ranges,fylist)
  80.    local i, j, k, line
  81.    while line := read() do
  82.       {
  83.       i := 1
  84.       while i <= *fylist do
  85.          {
  86.          j := ranges[i][1]
  87.          k := ranges[i][2]
  88.          if k > 0 then
  89.             write(fylist[i][2],line[j+:k] | line[j:0] | "")
  90.          i +:= 1
  91.          }
  92.       }
  93. end
  94.  
  95. # doutfyls - process the output file arguments; return list
  96. #
  97. procedure doutfyls(a,i)
  98.    local lst, x
  99.    lst := []
  100.    while \a[i] do
  101.       {
  102.       if x := llu(a[i],lst) then        # already in list
  103.          lst |||:= [[a[i],lst[x][2]]]
  104.       else                    # not in list
  105.          if a[i] == "-" then            # standard out
  106.             lst |||:= [[a[i],&output]]
  107.          else                    # new file
  108.             if not (x := open(a[i],"w")) then
  109.                stop("Cannot open ",a[i]," for output")
  110.             else
  111.                lst |||:= [[a[i],x]]
  112.       i +:= 1
  113.       }
  114.    return lst
  115.  
  116. end
  117.  
  118. # fldecode - decode the fieldlist argument
  119. #
  120. procedure fldecode(fldlst)
  121.    local fld, flst, poslst, m, n, x
  122.    poslst := []
  123.    flst := str2lst(fldlst,':,')
  124.    every fld := !flst do
  125.       {
  126.       if x := upto('-+',fld) then
  127.          {
  128.          if not (m := integer(fld[1:x])) then
  129.             stop("bad argument in field list; ",fld)
  130.          if not (n := integer(fld[x+1:0])) then
  131.             stop("bad argument in field list; ",fld)
  132.          if upto('-',fld) then
  133.             {
  134.             if n < m then
  135.                n := 0
  136.             else
  137.                n := (n - m) + 1
  138.             }
  139.          }
  140.       else {
  141.          if not (m := integer(fld)) then
  142.             stop("bad argument in field list; ",fld)
  143.          n := 1
  144.          }
  145.       poslst |||:= [[m,n]]
  146.       }
  147.    return poslst
  148. end
  149.  
  150. # llu - lookup file name in output file list
  151. #
  152. procedure llu(str,lst)
  153.    local i
  154.    i := 1
  155.    while \lst[i] do
  156.       {
  157.       if \lst[i][1] == str then
  158.          return i
  159.       i +:= 1
  160.       }
  161. end
  162.  
  163. # str2lst - create a list from a delimited string
  164. #
  165. procedure str2lst(str,delim)
  166.    local lst, f
  167.    lst := []
  168.    str ? {
  169.       while f := (tab(upto(delim))) do
  170.       {
  171.       lst |||:= [f]
  172.       move(1)
  173.       }
  174.         if "" ~== (f := tab(0)) then
  175.         lst |||:= [f]
  176.         }
  177.    return lst
  178. end
  179.